home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / unix / tkUnixSelect.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-31  |  33.3 KB  |  1,190 lines
  1. /* 
  2.  * tkUnixSelect.c --
  3.  *
  4.  *    This file contains X specific routines for manipulating 
  5.  *    selections.
  6.  *
  7.  * Copyright (c) 1995 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tkUnixSelect.c 1.5 96/03/29 14:14:31
  13.  */
  14.  
  15. #include "tkInt.h"
  16. #include "tkSelect.h"
  17.  
  18. /*
  19.  * When handling INCR-style selection retrievals, the selection owner
  20.  * uses the following data structure to communicate between the
  21.  * ConvertSelection procedure and TkSelPropProc.
  22.  */
  23.  
  24. typedef struct IncrInfo {
  25.     TkWindow *winPtr;        /* Window that owns selection. */
  26.     Atom selection;        /* Selection that is being retrieved. */
  27.     Atom *multAtoms;        /* Information about conversions to
  28.                  * perform:  one or more pairs of
  29.                  * (target, property).  This either
  30.                  * points to a retrieved  property (for
  31.                  * MULTIPLE retrievals) or to a static
  32.                  * array. */
  33.     unsigned long numConversions;
  34.                 /* Number of entries in offsets (same as
  35.                  * # of pairs in multAtoms). */
  36.     int *offsets;        /* One entry for each pair in
  37.                  * multAtoms;  -1 means all data has
  38.                  * been transferred for this
  39.                  * conversion.  -2 means only the
  40.                  * final zero-length transfer still
  41.                  * has to be done.  Otherwise it is the
  42.                  * offset of the next chunk of data
  43.                  * to transfer.  This array is malloc-ed. */
  44.     int numIncrs;        /* Number of entries in offsets that
  45.                  * aren't -1 (i.e. # of INCR-mode transfers
  46.                  * not yet completed). */
  47.     Tcl_TimerToken timeout;    /* Token for timer procedure. */
  48.     int idleTime;        /* Number of seconds since we heard
  49.                  * anything from the selection
  50.                  * requestor. */
  51.     Window reqWindow;        /* Requestor's window id. */
  52.     Time time;            /* Timestamp corresponding to
  53.                  * selection at beginning of request;
  54.                  * used to abort transfer if selection
  55.                  * changes. */
  56.     struct IncrInfo *nextPtr;    /* Next in list of all INCR-style
  57.                  * retrievals currently pending. */
  58. } IncrInfo;
  59.  
  60. static IncrInfo *pendingIncrs = NULL;
  61.                 /* List of all incr structures
  62.                  * currently active. */
  63.  
  64. /*
  65.  * Largest property that we'll accept when sending or receiving the
  66.  * selection:
  67.  */
  68.  
  69. #define MAX_PROP_WORDS 100000
  70.  
  71. static TkSelRetrievalInfo *pendingRetrievals = NULL;
  72.                 /* List of all retrievals currently
  73.                  * being waited for. */
  74.  
  75. /*
  76.  * Forward declarations for procedures defined in this file:
  77.  */
  78.  
  79. static void        ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
  80.                 XSelectionRequestEvent *eventPtr));
  81. static void        IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
  82. static char *        SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
  83.                 Atom type, Tk_Window tkwin));
  84. static long *        SelCvtToX _ANSI_ARGS_((char *string, Atom type,
  85.                 Tk_Window tkwin, int *numLongsPtr));
  86. static int        SelectionSize _ANSI_ARGS_((TkSelHandler *selPtr));
  87. static void        SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
  88.                 XEvent *eventPtr));
  89. static void        SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
  90.  
  91. /*
  92.  *----------------------------------------------------------------------
  93.  *
  94.  * TkSelGetSelection --
  95.  *
  96.  *    Retrieve the specified selection from another process.
  97.  *
  98.  * Results:
  99.  *    The return value is a standard Tcl return value.
  100.  *    If an error occurs (such as no selection exists)
  101.  *    then an error message is left in interp->result.
  102.  *
  103.  * Side effects:
  104.  *    None.
  105.  *
  106.  *----------------------------------------------------------------------
  107.  */
  108.  
  109. int
  110. TkSelGetSelection(interp, tkwin, selection, target, proc, clientData)
  111.     Tcl_Interp *interp;        /* Interpreter to use for reporting
  112.                  * errors. */
  113.     Tk_Window tkwin;        /* Window on whose behalf to retrieve
  114.                  * the selection (determines display
  115.                  * from which to retrieve). */
  116.     Atom selection;        /* Selection to retrieve. */
  117.     Atom target;        /* Desired form in which selection
  118.                  * is to be returned. */
  119.     Tk_GetSelProc *proc;    /* Procedure to call to process the
  120.                  * selection, once it has been retrieved. */
  121.     ClientData clientData;    /* Arbitrary value to pass to proc. */
  122. {
  123.     TkSelRetrievalInfo retr;
  124.     TkWindow *winPtr = (TkWindow *) tkwin;
  125.     TkDisplay *dispPtr = winPtr->dispPtr;
  126.  
  127.     /*
  128.      * The selection is owned by some other process.  To
  129.      * retrieve it, first record information about the retrieval
  130.      * in progress.  Use an internal window as the requestor.
  131.      */
  132.  
  133.     retr.interp = interp;
  134.     if (dispPtr->clipWindow == NULL) {
  135.     int result;
  136.  
  137.     result = TkClipInit(interp, dispPtr);
  138.     if (result != TCL_OK) {
  139.         return result;
  140.     }
  141.     }
  142.     retr.winPtr = (TkWindow *) dispPtr->clipWindow;
  143.     retr.selection = selection;
  144.     retr.property = selection;
  145.     retr.target = target;
  146.     retr.proc = proc;
  147.     retr.clientData = clientData;
  148.     retr.result = -1;
  149.     retr.idleTime = 0;
  150.     retr.nextPtr = pendingRetrievals;
  151.     pendingRetrievals = &retr;
  152.  
  153.     /*
  154.      * Initiate the request for the selection.  Note:  can't use
  155.      * TkCurrentTime for the time.  If we do, and this application hasn't
  156.      * received any X events in a long time, the current time will be way
  157.      * in the past and could even predate the time when the selection was
  158.      * made;  if this happens, the request will be rejected.
  159.      */
  160.  
  161.     XConvertSelection(winPtr->display, retr.selection, retr.target,
  162.         retr.property, retr.winPtr->window, CurrentTime);
  163.  
  164.     /*
  165.      * Enter a loop processing X events until the selection
  166.      * has been retrieved and processed.  If no response is
  167.      * received within a few seconds, then timeout.
  168.      */
  169.  
  170.     retr.timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
  171.         (ClientData) &retr);
  172.     while (retr.result == -1) {
  173.     Tcl_DoOneEvent(0);
  174.     }
  175.     Tcl_DeleteTimerHandler(retr.timeout);
  176.  
  177.     /*
  178.      * Unregister the information about the selection retrieval
  179.      * in progress.
  180.      */
  181.  
  182.     if (pendingRetrievals == &retr) {
  183.     pendingRetrievals = retr.nextPtr;
  184.     } else {
  185.     TkSelRetrievalInfo *retrPtr;
  186.  
  187.     for (retrPtr = pendingRetrievals; retrPtr != NULL;
  188.         retrPtr = retrPtr->nextPtr) {
  189.         if (retrPtr->nextPtr == &retr) {
  190.         retrPtr->nextPtr = retr.nextPtr;
  191.         break;
  192.         }
  193.     }
  194.     }
  195.     return retr.result;
  196. }
  197.  
  198. /*
  199.  *----------------------------------------------------------------------
  200.  *
  201.  * TkSelPropProc --
  202.  *
  203.  *    This procedure is invoked when property-change events
  204.  *    occur on windows not known to the toolkit.  Its function
  205.  *    is to implement the sending side of the INCR selection
  206.  *    retrieval protocol when the selection requestor deletes
  207.  *    the property containing a part of the selection.
  208.  *
  209.  * Results:
  210.  *    None.
  211.  *
  212.  * Side effects:
  213.  *    If the property that is receiving the selection was just
  214.  *    deleted, then a new piece of the selection is fetched and
  215.  *    placed in the property, until eventually there's no more
  216.  *    selection to fetch.
  217.  *
  218.  *----------------------------------------------------------------------
  219.  */
  220.  
  221. void
  222. TkSelPropProc(eventPtr)
  223.     register XEvent *eventPtr;        /* X PropertyChange event. */
  224. {
  225.     register IncrInfo *incrPtr;
  226.     int i, format;
  227.     Atom target, formatType;
  228.     register TkSelHandler *selPtr;
  229.     long buffer[TK_SEL_WORDS_AT_ONCE];
  230.     int numItems;
  231.     char *propPtr;
  232.     Tk_ErrorHandler errorHandler;
  233.  
  234.     /*
  235.      * See if this event announces the deletion of a property being
  236.      * used for an INCR transfer.  If so, then add the next chunk of
  237.      * data to the property.
  238.      */
  239.  
  240.     if (eventPtr->xproperty.state != PropertyDelete) {
  241.     return;
  242.     }
  243.     for (incrPtr = pendingIncrs; incrPtr != NULL;
  244.         incrPtr = incrPtr->nextPtr) {
  245.     if (incrPtr->reqWindow != eventPtr->xproperty.window) {
  246.         continue;
  247.     }
  248.     for (i = 0; i < incrPtr->numConversions; i++) {
  249.         if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1])
  250.             || (incrPtr->offsets[i] == -1)){
  251.         continue;
  252.         }
  253.         target = incrPtr->multAtoms[2*i];
  254.         incrPtr->idleTime = 0;
  255.         for (selPtr = incrPtr->winPtr->selHandlerList; ;
  256.             selPtr = selPtr->nextPtr) {
  257.         if (selPtr == NULL) {
  258.             incrPtr->multAtoms[2*i + 1] = None;
  259.             incrPtr->offsets[i] = -1;
  260.             incrPtr->numIncrs --;
  261.             return;
  262.         }
  263.         if ((selPtr->target == target)
  264.             && (selPtr->selection == incrPtr->selection)) {
  265.             formatType = selPtr->format;
  266.             if (incrPtr->offsets[i] == -2) {
  267.             numItems = 0;
  268.             ((char *) buffer)[0] = 0;
  269.             } else {
  270.             TkSelInProgress ip;
  271.             ip.selPtr = selPtr;
  272.             ip.nextPtr = pendingPtr;
  273.             pendingPtr = &ip;
  274.             numItems = (*selPtr->proc)(selPtr->clientData,
  275.                 incrPtr->offsets[i], (char *) buffer,
  276.                 TK_SEL_BYTES_AT_ONCE);
  277.             pendingPtr = ip.nextPtr;
  278.             if (ip.selPtr == NULL) {
  279.                 /*
  280.                  * The selection handler deleted itself.
  281.                  */
  282.  
  283.                 return;
  284.             }
  285.             if (numItems > TK_SEL_BYTES_AT_ONCE) {
  286.                 panic("selection handler returned too many bytes");
  287.             } else {
  288.                 if (numItems < 0) {
  289.                 numItems = 0;
  290.                 }
  291.             }
  292.             ((char *) buffer)[numItems] = '\0';
  293.             }
  294.             if (numItems < TK_SEL_BYTES_AT_ONCE) {
  295.             if (numItems <= 0) {
  296.                 incrPtr->offsets[i] = -1;
  297.                 incrPtr->numIncrs--;
  298.             } else {
  299.                 incrPtr->offsets[i] = -2;
  300.             }
  301.             } else {
  302.             incrPtr->offsets[i] += numItems;
  303.             }
  304.             if (formatType == XA_STRING) {
  305.             propPtr = (char *) buffer;
  306.             format = 8;
  307.             } else {
  308.             propPtr = (char *) SelCvtToX((char *) buffer,
  309.                 formatType, (Tk_Window) incrPtr->winPtr,
  310.                 &numItems);
  311.             format = 32;
  312.             }
  313.             errorHandler = Tk_CreateErrorHandler(
  314.                 eventPtr->xproperty.display, -1, -1, -1,
  315.                 (int (*)()) NULL, (ClientData) NULL);
  316.             XChangeProperty(eventPtr->xproperty.display,
  317.                 eventPtr->xproperty.window,
  318.                 eventPtr->xproperty.atom, formatType,
  319.                 format, PropModeReplace,
  320.                 (unsigned char *) propPtr, numItems);
  321.             Tk_DeleteErrorHandler(errorHandler);
  322.             if (propPtr != (char *) buffer) {
  323.             ckfree(propPtr);
  324.             }
  325.             return;
  326.         }
  327.         }
  328.     }
  329.     }
  330. }
  331.  
  332. /*
  333.  *--------------------------------------------------------------
  334.  *
  335.  * TkSelEventProc --
  336.  *
  337.  *    This procedure is invoked whenever a selection-related
  338.  *    event occurs.  It does the lion's share of the work
  339.  *    in implementing the selection protocol.
  340.  *
  341.  * Results:
  342.  *    None.
  343.  *
  344.  * Side effects:
  345.  *    Lots:  depends on the type of event.
  346.  *
  347.  *--------------------------------------------------------------
  348.  */
  349.  
  350. void
  351. TkSelEventProc(tkwin, eventPtr)
  352.     Tk_Window tkwin;        /* Window for which event was
  353.                  * targeted. */
  354.     register XEvent *eventPtr;    /* X event:  either SelectionClear,
  355.                  * SelectionRequest, or
  356.                  * SelectionNotify. */
  357. {
  358.     register TkWindow *winPtr = (TkWindow *) tkwin;
  359.     TkDisplay *dispPtr = winPtr->dispPtr;
  360.     Tcl_Interp *interp;
  361.  
  362.     /*
  363.      * Case #1: SelectionClear events.
  364.      */
  365.  
  366.     if (eventPtr->type == SelectionClear) {
  367.     TkSelClearSelection(tkwin, eventPtr);
  368.     }
  369.  
  370.     /*
  371.      * Case #2: SelectionNotify events.  Call the relevant procedure
  372.      * to handle the incoming selection.
  373.      */
  374.  
  375.     if (eventPtr->type == SelectionNotify) {
  376.     register TkSelRetrievalInfo *retrPtr;
  377.     char *propInfo;
  378.     Atom type;
  379.     int format, result;
  380.     unsigned long numItems, bytesAfter;
  381.  
  382.     for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
  383.         if (retrPtr == NULL) {
  384.         return;
  385.         }
  386.         if ((retrPtr->winPtr == winPtr)
  387.             && (retrPtr->selection == eventPtr->xselection.selection)
  388.             && (retrPtr->target == eventPtr->xselection.target)
  389.             && (retrPtr->result == -1)) {
  390.         if (retrPtr->property == eventPtr->xselection.property) {
  391.             break;
  392.         }
  393.         if (eventPtr->xselection.property == None) {
  394.             Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
  395.             Tcl_AppendResult(retrPtr->interp,
  396.                 Tk_GetAtomName(tkwin, retrPtr->selection),
  397.                 " selection doesn't exist or form \"",
  398.                 Tk_GetAtomName(tkwin, retrPtr->target),
  399.                 "\" not defined", (char *) NULL);
  400.             retrPtr->result = TCL_ERROR;
  401.             return;
  402.         }
  403.         }
  404.     }
  405.  
  406.     propInfo = NULL;
  407.     result = XGetWindowProperty(eventPtr->xselection.display,
  408.         eventPtr->xselection.requestor, retrPtr->property,
  409.         0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
  410.         &type, &format, &numItems, &bytesAfter,
  411.         (unsigned char **) &propInfo);
  412.     if ((result != Success) || (type == None)) {
  413.         return;
  414.     }
  415.     if (bytesAfter != 0) {
  416.         Tcl_SetResult(retrPtr->interp, "selection property too large",
  417.         TCL_STATIC);
  418.         retrPtr->result = TCL_ERROR;
  419.         XFree(propInfo);
  420.         return;
  421.     }
  422.     if ((type == XA_STRING) || (type == dispPtr->textAtom)
  423.         || (type == dispPtr->compoundTextAtom)) {
  424.         if (format != 8) {
  425.         sprintf(retrPtr->interp->result,
  426.             "bad format for string selection: wanted \"8\", got \"%d\"",
  427.             format);
  428.         retrPtr->result = TCL_ERROR;
  429.         return;
  430.         }
  431.             interp = retrPtr->interp;
  432.             Tcl_Preserve((ClientData) interp);
  433.         retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
  434.             interp, propInfo);
  435.             Tcl_Release((ClientData) interp);
  436.     } else if (type == dispPtr->incrAtom) {
  437.  
  438.         /*
  439.          * It's a !?#@!?!! INCR-style reception.  Arrange to receive
  440.          * the selection in pieces, using the ICCCM protocol, then
  441.          * hang around until either the selection is all here or a
  442.          * timeout occurs.
  443.          */
  444.  
  445.         retrPtr->idleTime = 0;
  446.         Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
  447.             (ClientData) retrPtr);
  448.         XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
  449.             retrPtr->property);
  450.         while (retrPtr->result == -1) {
  451.         Tcl_DoOneEvent(0);
  452.         }
  453.         Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
  454.             (ClientData) retrPtr);
  455.     } else {
  456.         char *string;
  457.  
  458.         if (format != 32) {
  459.         sprintf(retrPtr->interp->result,
  460.             "bad format for selection: wanted \"32\", got \"%d\"",
  461.             format);
  462.         retrPtr->result = TCL_ERROR;
  463.         return;
  464.         }
  465.         string = SelCvtFromX((long *) propInfo, (int) numItems, type,
  466.             (Tk_Window) winPtr);
  467.             interp = retrPtr->interp;
  468.             Tcl_Preserve((ClientData) interp);
  469.         retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
  470.             interp, string);
  471.             Tcl_Release((ClientData) interp);
  472.         ckfree(string);
  473.     }
  474.     XFree(propInfo);
  475.     return;
  476.     }
  477.  
  478.     /*
  479.      * Case #3: SelectionRequest events.  Call ConvertSelection to
  480.      * do the dirty work.
  481.      */
  482.  
  483.     if (eventPtr->type == SelectionRequest) {
  484.     ConvertSelection(winPtr, &eventPtr->xselectionrequest);
  485.     return;
  486.     }
  487. }
  488.  
  489. /*
  490.  *----------------------------------------------------------------------
  491.  *
  492.  * SelTimeoutProc --
  493.  *
  494.  *    This procedure is invoked once every second while waiting for
  495.  *    the selection to be returned.  After a while it gives up and
  496.  *    aborts the selection retrieval.
  497.  *
  498.  * Results:
  499.  *    None.
  500.  *
  501.  * Side effects:
  502.  *    A new timer callback is created to call us again in another
  503.  *    second, unless time has expired, in which case an error is
  504.  *    recorded for the retrieval.
  505.  *
  506.  *----------------------------------------------------------------------
  507.  */
  508.  
  509. static void
  510. SelTimeoutProc(clientData)
  511.     ClientData clientData;        /* Information about retrieval
  512.                      * in progress. */
  513. {
  514.     register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
  515.  
  516.     /*
  517.      * Make sure that the retrieval is still in progress.  Then
  518.      * see how long it's been since any sort of response was received
  519.      * from the other side.
  520.      */
  521.  
  522.     if (retrPtr->result != -1) {
  523.     return;
  524.     }
  525.     retrPtr->idleTime++;
  526.     if (retrPtr->idleTime >= 5) {
  527.  
  528.     /*
  529.      * Use a careful procedure to store the error message, because
  530.      * the result could already be partially filled in with a partial
  531.      * selection return.
  532.      */
  533.  
  534.     Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
  535.         TCL_STATIC);
  536.     retrPtr->result = TCL_ERROR;
  537.     } else {
  538.     retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
  539.         (ClientData) retrPtr);
  540.     }
  541. }
  542.  
  543. /*
  544.  *----------------------------------------------------------------------
  545.  *
  546.  * ConvertSelection --
  547.  *
  548.  *    This procedure is invoked to handle SelectionRequest events.
  549.  *    It responds to the requests, obeying the ICCCM protocols.
  550.  *
  551.  * Results:
  552.  *    None.
  553.  *
  554.  * Side effects:
  555.  *    Properties are created for the selection requestor, and a
  556.  *    SelectionNotify event is generated for the selection
  557.  *    requestor.  In the event of long selections, this procedure
  558.  *    implements INCR-mode transfers, using the ICCCM protocol.
  559.  *
  560.  *----------------------------------------------------------------------
  561.  */
  562.  
  563. static void
  564. ConvertSelection(winPtr, eventPtr)
  565.     TkWindow *winPtr;            /* Window that received the
  566.                      * conversion request;  may not be
  567.                      * selection's current owner, be we
  568.                      * set it to the current owner. */
  569.     register XSelectionRequestEvent *eventPtr;
  570.                     /* Event describing request. */
  571. {
  572.     XSelectionEvent reply;        /* Used to notify requestor that
  573.                      * selection info is ready. */
  574.     int multiple;            /* Non-zero means a MULTIPLE request
  575.                      * is being handled. */
  576.     IncrInfo incr;            /* State of selection conversion. */
  577.     Atom singleInfo[2];            /* incr.multAtoms points here except
  578.                      * for multiple conversions. */
  579.     int i;
  580.     Tk_ErrorHandler errorHandler;
  581.     TkSelectionInfo *infoPtr;
  582.     TkSelInProgress ip;
  583.  
  584.     errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
  585.         (int (*)()) NULL, (ClientData) NULL);
  586.  
  587.     /*
  588.      * Initialize the reply event.
  589.      */
  590.  
  591.     reply.type = SelectionNotify;
  592.     reply.serial = 0;
  593.     reply.send_event = True;
  594.     reply.display = eventPtr->display;
  595.     reply.requestor = eventPtr->requestor;
  596.     reply.selection = eventPtr->selection;
  597.     reply.target = eventPtr->target;
  598.     reply.property = eventPtr->property;
  599.     if (reply.property == None) {
  600.     reply.property = reply.target;
  601.     }
  602.     reply.time = eventPtr->time;
  603.  
  604.     for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
  605.         infoPtr = infoPtr->nextPtr) {
  606.     if (infoPtr->selection == eventPtr->selection)
  607.         break;
  608.     }
  609.     if (infoPtr == NULL) {
  610.     goto refuse;
  611.     }
  612.     winPtr = (TkWindow *) infoPtr->owner;
  613.  
  614.     /*
  615.      * Figure out which kind(s) of conversion to perform.  If handling
  616.      * a MULTIPLE conversion, then read the property describing which
  617.      * conversions to perform.
  618.      */
  619.  
  620.     incr.winPtr = winPtr;
  621.     incr.selection = eventPtr->selection;
  622.     if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
  623.     multiple = 0;
  624.     singleInfo[0] = reply.target;
  625.     singleInfo[1] = reply.property;
  626.     incr.multAtoms = singleInfo;
  627.     incr.numConversions = 1;
  628.     } else {
  629.     Atom type;
  630.     int format, result;
  631.     unsigned long bytesAfter;
  632.  
  633.     multiple = 1;
  634.     incr.multAtoms = NULL;
  635.     if (eventPtr->property == None) {
  636.         goto refuse;
  637.     }
  638.     result = XGetWindowProperty(eventPtr->display,
  639.         eventPtr->requestor, eventPtr->property,
  640.         0, MAX_PROP_WORDS, False, XA_ATOM,
  641.         &type, &format, &incr.numConversions, &bytesAfter,
  642.         (unsigned char **) &incr.multAtoms);
  643.     if ((result != Success) || (bytesAfter != 0) || (format != 32)
  644.         || (type == None)) {
  645.         if (incr.multAtoms != NULL) {
  646.         XFree((char *) incr.multAtoms);
  647.         }
  648.         goto refuse;
  649.     }
  650.     incr.numConversions /= 2;        /* Two atoms per conversion. */
  651.     }
  652.  
  653.     /*
  654.      * Loop through all of the requested conversions, and either return
  655.      * the entire converted selection, if it can be returned in a single
  656.      * bunch, or return INCR information only (the actual selection will
  657.      * be returned below).
  658.      */
  659.  
  660.     incr.offsets = (int *) ckalloc((unsigned)
  661.         (incr.numConversions*sizeof(int)));
  662.     incr.numIncrs = 0;
  663.     for (i = 0; i < incr.numConversions; i++) {
  664.     Atom target, property, type;
  665.     long buffer[TK_SEL_WORDS_AT_ONCE];
  666.     register TkSelHandler *selPtr;
  667.     int numItems, format;
  668.     char *propPtr;
  669.  
  670.     target = incr.multAtoms[2*i];
  671.     property = incr.multAtoms[2*i + 1];
  672.     incr.offsets[i] = -1;
  673.  
  674.     for (selPtr = winPtr->selHandlerList; selPtr != NULL;
  675.         selPtr = selPtr->nextPtr) {
  676.         if ((selPtr->target == target)
  677.             && (selPtr->selection == eventPtr->selection)) {
  678.         break;
  679.         }
  680.     }
  681.  
  682.     if (selPtr == NULL) {
  683.         /*
  684.          * Nobody seems to know about this kind of request.  If
  685.          * it's of a sort that we can handle without any help, do
  686.          * it.  Otherwise mark the request as an errror.
  687.          */
  688.  
  689.         numItems = TkSelDefaultSelection(infoPtr, target, (char *) buffer,
  690.             TK_SEL_BYTES_AT_ONCE, &type);
  691.         if (numItems < 0) {
  692.         incr.multAtoms[2*i + 1] = None;
  693.         continue;
  694.         }
  695.     } else {
  696.         ip.selPtr = selPtr;
  697.         ip.nextPtr = pendingPtr;
  698.         pendingPtr = &ip;
  699.         type = selPtr->format;
  700.         numItems = (*selPtr->proc)(selPtr->clientData, 0,
  701.             (char *) buffer, TK_SEL_BYTES_AT_ONCE);
  702.         pendingPtr = ip.nextPtr;
  703.         if ((ip.selPtr == NULL) || (numItems < 0)) {
  704.         incr.multAtoms[2*i + 1] = None;
  705.         continue;
  706.         }
  707.         if (numItems > TK_SEL_BYTES_AT_ONCE) {
  708.         panic("selection handler returned too many bytes");
  709.         }
  710.         ((char *) buffer)[numItems] = '\0';
  711.     }
  712.  
  713.     /*
  714.      * Got the selection;  store it back on the requestor's property.
  715.      */
  716.  
  717.     if (numItems == TK_SEL_BYTES_AT_ONCE) {
  718.         /*
  719.          * Selection is too big to send at once;  start an
  720.          * INCR-mode transfer.
  721.          */
  722.  
  723.         incr.numIncrs++;
  724.         type = winPtr->dispPtr->incrAtom;
  725.         buffer[0] = SelectionSize(selPtr);
  726.         if (buffer[0] == 0) {
  727.         incr.multAtoms[2*i + 1] = None;
  728.         continue;
  729.         }
  730.         numItems = 1;
  731.         propPtr = (char *) buffer;
  732.         format = 32;
  733.         incr.offsets[i] = 0;
  734.     } else if (type == XA_STRING) {
  735.         propPtr = (char *) buffer;
  736.         format = 8;
  737.     } else {
  738.         propPtr = (char *) SelCvtToX((char *) buffer,
  739.             type, (Tk_Window) winPtr, &numItems);
  740.         format = 32;
  741.     }
  742.     XChangeProperty(reply.display, reply.requestor,
  743.         property, type, format, PropModeReplace,
  744.         (unsigned char *) propPtr, numItems);
  745.     if (propPtr != (char *) buffer) {
  746.         ckfree(propPtr);
  747.     }
  748.     }
  749.  
  750.     /*
  751.      * Send an event back to the requestor to indicate that the
  752.      * first stage of conversion is complete (everything is done
  753.      * except for long conversions that have to be done in INCR
  754.      * mode).
  755.      */
  756.  
  757.     if (incr.numIncrs > 0) {
  758.     XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
  759.     incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
  760.         (ClientData) &incr);
  761.     incr.idleTime = 0;
  762.     incr.reqWindow = reply.requestor;
  763.     incr.time = infoPtr->time;
  764.     incr.nextPtr = pendingIncrs;
  765.     pendingIncrs = &incr;
  766.     }
  767.     if (multiple) {
  768.     XChangeProperty(reply.display, reply.requestor, reply.property,
  769.         XA_ATOM, 32, PropModeReplace,
  770.         (unsigned char *) incr.multAtoms,
  771.         (int) incr.numConversions*2);
  772.     } else {
  773.  
  774.     /*
  775.      * Not a MULTIPLE request.  The first property in "multAtoms"
  776.      * got set to None if there was an error in conversion.
  777.      */
  778.  
  779.     reply.property = incr.multAtoms[1];
  780.     }
  781.     XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
  782.     Tk_DeleteErrorHandler(errorHandler);
  783.  
  784.     /*
  785.      * Handle any remaining INCR-mode transfers.  This all happens
  786.      * in callbacks to TkSelPropProc, so just wait until the number
  787.      * of uncompleted INCR transfers drops to zero.
  788.      */
  789.  
  790.     if (incr.numIncrs > 0) {
  791.     IncrInfo *incrPtr2;
  792.  
  793.     while (incr.numIncrs > 0) {
  794.         Tcl_DoOneEvent(0);
  795.     }
  796.     Tcl_DeleteTimerHandler(incr.timeout);
  797.     errorHandler = Tk_CreateErrorHandler(winPtr->display,
  798.         -1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
  799.     XSelectInput(reply.display, reply.requestor, 0L);
  800.     Tk_DeleteErrorHandler(errorHandler);
  801.     if (pendingIncrs == &incr) {
  802.         pendingIncrs = incr.nextPtr;
  803.     } else {
  804.         for (incrPtr2 = pendingIncrs; incrPtr2 != NULL;
  805.             incrPtr2 = incrPtr2->nextPtr) {
  806.         if (incrPtr2->nextPtr == &incr) {
  807.             incrPtr2->nextPtr = incr.nextPtr;
  808.             break;
  809.         }
  810.         }
  811.     }
  812.     }
  813.  
  814.     /*
  815.      * All done.  Cleanup and return.
  816.      */
  817.  
  818.     ckfree((char *) incr.offsets);
  819.     if (multiple) {
  820.     XFree((char *) incr.multAtoms);
  821.     }
  822.     return;
  823.  
  824.     /*
  825.      * An error occurred.  Send back a refusal message.
  826.      */
  827.  
  828.     refuse:
  829.     reply.property = None;
  830.     XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
  831.     Tk_DeleteErrorHandler(errorHandler);
  832.     return;
  833. }
  834.  
  835. /*
  836.  *----------------------------------------------------------------------
  837.  *
  838.  * SelRcvIncrProc --
  839.  *
  840.  *    This procedure handles the INCR protocol on the receiving
  841.  *    side.  It is invoked in response to property changes on
  842.  *    the requestor's window (which hopefully are because a new
  843.  *    chunk of the selection arrived).
  844.  *
  845.  * Results:
  846.  *    None.
  847.  *
  848.  * Side effects:
  849.  *    If a new piece of selection has arrived, a procedure is
  850.  *    invoked to deal with that piece.  When the whole selection
  851.  *    is here, a flag is left for the higher-level procedure that
  852.  *    initiated the selection retrieval.
  853.  *
  854.  *----------------------------------------------------------------------
  855.  */
  856.  
  857. static void
  858. SelRcvIncrProc(clientData, eventPtr)
  859.     ClientData clientData;        /* Information about retrieval. */
  860.     register XEvent *eventPtr;        /* X PropertyChange event. */
  861. {
  862.     register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
  863.     char *propInfo;
  864.     Atom type;
  865.     int format, result;
  866.     unsigned long numItems, bytesAfter;
  867.     Tcl_Interp *interp;
  868.  
  869.     if ((eventPtr->xproperty.atom != retrPtr->property)
  870.         || (eventPtr->xproperty.state != PropertyNewValue)
  871.         || (retrPtr->result != -1)) {
  872.     return;
  873.     }
  874.     propInfo = NULL;
  875.     result = XGetWindowProperty(eventPtr->xproperty.display,
  876.         eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
  877.         True, (Atom) AnyPropertyType, &type, &format, &numItems,
  878.         &bytesAfter, (unsigned char **) &propInfo);
  879.     if ((result != Success) || (type == None)) {
  880.     return;
  881.     }
  882.     if (bytesAfter != 0) {
  883.     Tcl_SetResult(retrPtr->interp, "selection property too large",
  884.         TCL_STATIC);
  885.     retrPtr->result = TCL_ERROR;
  886.     goto done;
  887.     }
  888.     if (numItems == 0) {
  889.     retrPtr->result = TCL_OK;
  890.     } else if ((type == XA_STRING)
  891.         || (type == retrPtr->winPtr->dispPtr->textAtom)
  892.         || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
  893.     if (format != 8) {
  894.         Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
  895.         sprintf(retrPtr->interp->result,
  896.         "bad format for string selection: wanted \"8\", got \"%d\"",
  897.         format);
  898.         retrPtr->result = TCL_ERROR;
  899.         goto done;
  900.     }
  901.         interp = retrPtr->interp;
  902.         Tcl_Preserve((ClientData) interp);
  903.     result = (*retrPtr->proc)(retrPtr->clientData, interp, propInfo);
  904.         Tcl_Release((ClientData) interp);
  905.     if (result != TCL_OK) {
  906.         retrPtr->result = result;
  907.     }
  908.     } else {
  909.     char *string;
  910.  
  911.     if (format != 32) {
  912.         Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
  913.         sprintf(retrPtr->interp->result,
  914.         "bad format for selection: wanted \"32\", got \"%d\"",
  915.         format);
  916.         retrPtr->result = TCL_ERROR;
  917.         goto done;
  918.     }
  919.     string = SelCvtFromX((long *) propInfo, (int) numItems, type,
  920.         (Tk_Window) retrPtr->winPtr);
  921.         interp = retrPtr->interp;
  922.         Tcl_Preserve((ClientData) interp);
  923.     result = (*retrPtr->proc)(retrPtr->clientData, interp, string);
  924.         Tcl_Release((ClientData) interp);
  925.     if (result != TCL_OK) {
  926.         retrPtr->result = result;
  927.     }
  928.     ckfree(string);
  929.     }
  930.  
  931.     done:
  932.     XFree(propInfo);
  933.     retrPtr->idleTime = 0;
  934. }
  935.  
  936. /*
  937.  *----------------------------------------------------------------------
  938.  *
  939.  * SelectionSize --
  940.  *
  941.  *    This procedure is called when the selection is too large to
  942.  *    send in a single buffer;  it computes the total length of
  943.  *    the selection in bytes.
  944.  *
  945.  * Results:
  946.  *    The return value is the number of bytes in the selection
  947.  *    given by selPtr.
  948.  *
  949.  * Side effects:
  950.  *    The selection is retrieved from its current owner (this is
  951.  *    the only way to compute its size).
  952.  *
  953.  *----------------------------------------------------------------------
  954.  */
  955.  
  956. static int
  957. SelectionSize(selPtr)
  958.     TkSelHandler *selPtr;    /* Information about how to retrieve
  959.                  * the selection whose size is wanted. */
  960. {
  961.     char buffer[TK_SEL_BYTES_AT_ONCE+1];
  962.     int size, chunkSize;
  963.     TkSelInProgress ip;
  964.  
  965.     size = TK_SEL_BYTES_AT_ONCE;
  966.     ip.selPtr = selPtr;
  967.     ip.nextPtr = pendingPtr;
  968.     pendingPtr = &ip;
  969.     do {
  970.     chunkSize = (*selPtr->proc)(selPtr->clientData, size,
  971.             (char *) buffer, TK_SEL_BYTES_AT_ONCE);
  972.     if (ip.selPtr == NULL) {
  973.         size = 0;
  974.         break;
  975.     }
  976.     size += chunkSize;
  977.     } while (chunkSize == TK_SEL_BYTES_AT_ONCE);
  978.     pendingPtr = ip.nextPtr;
  979.     return size;
  980. }
  981.  
  982. /*
  983.  *----------------------------------------------------------------------
  984.  *
  985.  * IncrTimeoutProc --
  986.  *
  987.  *    This procedure is invoked once a second while sending the
  988.  *    selection to a requestor in INCR mode.  After a while it
  989.  *    gives up and aborts the selection operation.
  990.  *
  991.  * Results:
  992.  *    None.
  993.  *
  994.  * Side effects:
  995.  *    A new timeout gets registered so that this procedure gets
  996.  *    called again in another second, unless too many seconds
  997.  *    have elapsed, in which case incrPtr is marked as "all done".
  998.  *
  999.  *----------------------------------------------------------------------
  1000.  */
  1001.  
  1002. static void
  1003. IncrTimeoutProc(clientData)
  1004.     ClientData clientData;        /* Information about INCR-mode
  1005.                      * selection retrieval for which
  1006.                      * we are selection owner. */
  1007. {
  1008.     register IncrInfo *incrPtr = (IncrInfo *) clientData;
  1009.  
  1010.     incrPtr->idleTime++;
  1011.     if (incrPtr->idleTime >= 5) {
  1012.     incrPtr->numIncrs = 0;
  1013.     } else {
  1014.     incrPtr->timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
  1015.         (ClientData) incrPtr);
  1016.     }
  1017. }
  1018.  
  1019. /*
  1020.  *----------------------------------------------------------------------
  1021.  *
  1022.  * SelCvtToX --
  1023.  *
  1024.  *    Given a selection represented as a string (the normal Tcl form),
  1025.  *    convert it to the ICCCM-mandated format for X, depending on
  1026.  *    the type argument.  This procedure and SelCvtFromX are inverses.
  1027.  *
  1028.  * Results:
  1029.  *    The return value is a malloc'ed buffer holding a value
  1030.  *    equivalent to "string", but formatted as for "type".  It is
  1031.  *    the caller's responsibility to free the string when done with
  1032.  *    it.  The word at *numLongsPtr is filled in with the number of
  1033.  *    32-bit words returned in the result.
  1034.  *
  1035.  * Side effects:
  1036.  *    None.
  1037.  *
  1038.  *----------------------------------------------------------------------
  1039.  */
  1040.  
  1041. static long *
  1042. SelCvtToX(string, type, tkwin, numLongsPtr)
  1043.     char *string;        /* String representation of selection. */
  1044.     Atom type;            /* Atom specifying the X format that is
  1045.                  * desired for the selection.  Should not
  1046.                  * be XA_STRING (if so, don't bother calling
  1047.                  * this procedure at all). */
  1048.     Tk_Window tkwin;        /* Window that governs atom conversion. */
  1049.     int *numLongsPtr;        /* Number of 32-bit words contained in the
  1050.                  * result. */
  1051. {
  1052.     register char *p;
  1053.     char *field;
  1054.     int numFields;
  1055.     long *propPtr, *longPtr;
  1056. #define MAX_ATOM_NAME_LENGTH 100
  1057.     char atomName[MAX_ATOM_NAME_LENGTH+1];
  1058.  
  1059.     /*
  1060.      * The string is assumed to consist of fields separated by spaces.
  1061.      * The property gets generated by converting each field to an
  1062.      * integer number, in one of two ways:
  1063.      * 1. If type is XA_ATOM, convert each field to its corresponding
  1064.      *      atom.
  1065.      * 2. If type is anything else, convert each field from an ASCII number
  1066.      *    to a 32-bit binary number.
  1067.      */
  1068.  
  1069.     numFields = 1;
  1070.     for (p = string; *p != 0; p++) {
  1071.     if (isspace(UCHAR(*p))) {
  1072.         numFields++;
  1073.     }
  1074.     }
  1075.     propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long));
  1076.  
  1077.     /*
  1078.      * Convert the fields one-by-one.
  1079.      */
  1080.  
  1081.     for (longPtr = propPtr, *numLongsPtr = 0, p = string;
  1082.         ; longPtr++, (*numLongsPtr)++) {
  1083.     while (isspace(UCHAR(*p))) {
  1084.         p++;
  1085.     }
  1086.     if (*p == 0) {
  1087.         break;
  1088.     }
  1089.     field = p;
  1090.     while ((*p != 0) && !isspace(UCHAR(*p))) {
  1091.         p++;
  1092.     }
  1093.     if (type == XA_ATOM) {
  1094.         int length;
  1095.  
  1096.         length = p - field;
  1097.         if (length > MAX_ATOM_NAME_LENGTH) {
  1098.         length = MAX_ATOM_NAME_LENGTH;
  1099.         }
  1100.         strncpy(atomName, field, (unsigned) length);
  1101.         atomName[length] = 0;
  1102.         *longPtr = (long) Tk_InternAtom(tkwin, atomName);
  1103.     } else {
  1104.         char *dummy;
  1105.  
  1106.         *longPtr = strtol(field, &dummy, 0);
  1107.     }
  1108.     }
  1109.     return propPtr;
  1110. }
  1111.  
  1112. /*
  1113.  *----------------------------------------------------------------------
  1114.  *
  1115.  * SelCvtFromX --
  1116.  *
  1117.  *    Given an X property value, formatted as a collection of 32-bit
  1118.  *    values according to "type" and the ICCCM conventions, convert
  1119.  *    the value to a string suitable for manipulation by Tcl.  This
  1120.  *    procedure is the inverse of SelCvtToX.
  1121.  *
  1122.  * Results:
  1123.  *    The return value is the string equivalent of "property".  It is
  1124.  *    malloc-ed and should be freed by the caller when no longer
  1125.  *    needed.
  1126.  *
  1127.  * Side effects:
  1128.  *    None.
  1129.  *
  1130.  *----------------------------------------------------------------------
  1131.  */
  1132.  
  1133. static char *
  1134. SelCvtFromX(propPtr, numValues, type, tkwin)
  1135.     register long *propPtr;    /* Property value from X. */
  1136.     int numValues;        /* Number of 32-bit values in property. */
  1137.     Atom type;            /* Type of property  Should not be
  1138.                  * XA_STRING (if so, don't bother calling
  1139.                  * this procedure at all). */
  1140.     Tk_Window tkwin;        /* Window to use for atom conversion. */
  1141. {
  1142.     char *result;
  1143.     int resultSpace, curSize, fieldSize;
  1144.     char *atomName;
  1145.  
  1146.     /*
  1147.      * Convert each long in the property to a string value, which is
  1148.      * either the name of an atom (if type is XA_ATOM) or a hexadecimal
  1149.      * string.  Make an initial guess about the size of the result, but
  1150.      * be prepared to enlarge the result if necessary.
  1151.      */
  1152.  
  1153.     resultSpace = 12*numValues+1;
  1154.     curSize = 0;
  1155.     atomName = "";    /* Not needed, but eliminates compiler warning. */
  1156.     result = (char *) ckalloc((unsigned) resultSpace);
  1157.     *result  = '\0';
  1158.     for ( ; numValues > 0; propPtr++, numValues--) {
  1159.     if (type == XA_ATOM) {
  1160.         atomName = Tk_GetAtomName(tkwin, (Atom) *propPtr);
  1161.         fieldSize = strlen(atomName) + 1;
  1162.     } else {
  1163.         fieldSize = 12;
  1164.     }
  1165.     if (curSize+fieldSize >= resultSpace) {
  1166.         char *newResult;
  1167.  
  1168.         resultSpace *= 2;
  1169.         if (curSize+fieldSize >= resultSpace) {
  1170.         resultSpace = curSize + fieldSize + 1;
  1171.         }
  1172.         newResult = (char *) ckalloc((unsigned) resultSpace);
  1173.         strncpy(newResult, result, (unsigned) curSize);
  1174.         ckfree(result);
  1175.         result = newResult;
  1176.     }
  1177.     if (curSize != 0) {
  1178.         result[curSize] = ' ';
  1179.         curSize++;
  1180.     }
  1181.     if (type == XA_ATOM) {
  1182.         strcpy(result+curSize, atomName);
  1183.     } else {
  1184.         sprintf(result+curSize, "0x%x", (unsigned int) *propPtr);
  1185.     }
  1186.     curSize += strlen(result+curSize);
  1187.     }
  1188.     return result;
  1189. }
  1190.